perm filename EVAL3.LSP[W78,JMC] blob sn#339347 filedate 1978-03-09 generic text, type T, neo UTF8

(DEFUN FFEVAL (E A) 
       (COND ((ATOM E)
	      (COND ((EQ E NIL) NIL) ((EQ E T) T)
		    (T (CDR ((LABEL
			      FFASSOC
			      (LAMBDA (E A) 
				      (COND ((NULL A) NIL)
					    ((EQ E (CAAR A)) (CAR A))
					    (T (FFASSOC E (CDR A))))))
			     E
			     A)))))
	     ((ATOM (CAR E))
	      (COND ((EQ (CAR E) 'QUOTE) (CADR E))
		    ((EQ (CAR E) 'CAR)
		     (CAR (FFEVAL (CADR E) A)))
		    ((EQ (CAR E) 'CDR)
		     (CDR (FFEVAL (CADR E) A)))
		    ((EQ (CAR E) 'CADR)
		     (CADR (FFEVAL (CADR E) A)))
		    ((EQ (CAR E) 'CADDR)
		     (CADDR (FFEVAL (CADR E) A)))
		    ((EQ (CAR E) 'CAAR)
		     (CAAR (FFEVAL (CADR E) A)))
		    ((EQ (CAR E) 'CADAR)
		     (CADAR (FFEVAL (CADR E) A)))
		    ((EQ (CAR E) 'CADDAR)
		     (CADDAR (FFEVAL (CADR E) A)))
		    ((EQ (CAR E) 'ATOM)
		     (ATOM (FFEVAL (CADR E) A)))
		    ((EQ (CAR E) 'NULL)
		     (NULL (FFEVAL (CADR E) A)))
		    ((EQ (CAR E) 'CONS)
		     (CONS (FFEVAL (CADR E) A) (FFEVAL (CADDR E) A)))
		    ((EQ (CAR E) 'EQ)
		     (EQ (FFEVAL (CADR E) A) (FFEVAL (CADDR E) A)))
		    ((EQ (CAR E) 'COND)
		     ((LABEL FFEVCOND
			     (LAMBDA (U A) (COND ((FFEVAL (CAAR U) A)
						  (FFEVAL (CADAR U)
							  A))
						 (T (FFEVCOND (CDR U)
							      A)))))
		      (CDR E)
		      A))
		    (T (FFEVAL (CONS (CDR ((LABEL
					    FFASSOC
					    (LAMBDA (E A) 
					     (COND
					      ((NULL A) NIL)
					      ((EQ E (CAAR A))
					       (CAR A))
					      (T (FFASSOC E
							  (CDR A))))))
					   (CAR E)
					   A))
				     (CDR E))
			       A))))
	     ((EQ (CAAR E) 'LAMBDA)
	      (FFEVAL (CADDAR E)
		      ((LABEL FFAPPEND
			      (LAMBDA (U V) 
				      (COND ((NULL U) V)
					    (T (CONS (CAR U)
						     (FFAPPEND (CDR 
U)							       V))))))
		       ((LABEL
			 PAIRUP
			 (LAMBDA (U V) 
				 (COND ((NULL U) NIL)
				       (T (CONS (CONS (CAR U) (CAR V))
						(PAIRUP (CDR U)
							(CDR V)))))))
			(CADAR E)
			((LABEL
			  FFEVLIS
			  (LAMBDA (U A) 
				  (COND ((NULL U) NIL)
					(T (CONS (FFEVAL (CAR U) A)
						 (FFEVLIS (CDR U)
							  A))))))
			 (CDR E)
			 A))
		       A)))
	     ((EQ (CAAR E) 'LABEL)
	      (FFEVAL (CONS (CADDAR E) (CDR E))
		      (CONS (CONS (CADAR E) (CAR E)) A)))))